(defun c:f-align (/	    M_UP      M_DOWN	M_LEFT	  M_RIGHT
		  R_CCW	    R_CW      ENTER	raw-input-pair
		  block	    block-ent key-code	point	  y
		  x	    ang
		 )
  (setq M_UP (list 119 87 246 214))
  (setq M_DOWN (list 115 83 251 219))
  (setq M_RIGHT (list 100 68 226 194))
  (setq M_LEFT (list 97 65 244 212))
  (setq R_CCW (list 44 225 193))
  (setq R_CW (list 46 254 222))
  (setq ENTER 13)
  (setq block (ssname (ssget ":S" '((0 . "INSERT"))) 0))
  (while (not (equal (setq raw-input-pair (grread nil 6 0)) '(2 13)))
    (if	(equal (car raw-input-pair) 2)
      (progn
	(setq block-ent (entget block))
	(setq key-code (cadr raw-input-pair))
	(cond
	  ;; Move UP
	  ((or (member key-code M_UP))
	   (progn
	     (setq block-ent (subst (cons 10
					  (subst (1+ (setq y (cadr (setq point
									  (cdr (assoc 10 block-ent)
									  )
								   )
							     )
						     )
						 )
						 y
						 point
					  )
				    )
				    (assoc 10 block-ent)
				    block-ent
			     )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  ;; Move DOWN
	  ((or (member key-code M_DOWN))
	   (progn
	     (setq block-ent (subst (cons 10
					  (subst (1- (setq y (cadr (setq point
									  (cdr (assoc 10 block-ent)
									  )
								   )
							     )
						     )
						 )
						 y
						 point
					  )
				    )
				    (assoc 10 block-ent)
				    block-ent
			     )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  ;; Move RIGHT
	  ((or (member key-code M_RIGHT))
	   (progn
	     (setq block-ent (subst (cons 10
					  (subst (1+ (setq x (car (setq	point
									 (cdr (assoc 10 block-ent)
									 )
								  )
							     )
						     )
						 )
						 x
						 point
					  )
				    )
				    (assoc 10 block-ent)
				    block-ent
			     )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  ;; Move LEFT
	  ((or (member key-code M_LEFT))
	   (progn
	     (setq block-ent (subst (cons 10
					  (subst (1- (setq x (car (setq	point
									 (cdr (assoc 10 block-ent)
									 )
								  )
							     )
						     )
						 )
						 x
						 point
					  )
				    )
				    (assoc 10 block-ent)
				    block-ent
			     )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  ;; Rotate CCW
	  ((or (member key-code R_CCW))
	   (progn
	     (setq block-ent
		    (subst
		      (cons 50
			    (+ (cdr (setq ang (assoc 50 block-ent)))
			       (/ pi 180.)
			    )
		      )
		      ang
		      block-ent
		    )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  ;; Rotate CW
	  ((or (member key-code R_CW))
	   (progn
	     (setq block-ent
		    (subst
		      (cons 50
			    (- (cdr (setq ang (assoc 50 block-ent)))
			       (/ pi 180.)
			    )
		      )
		      ang
		      block-ent
		    )
	     )
	     (entmod block-ent)
	     (entupd block)
	   )
	  )
	  (t nil)
	)
      )
    )
  )
  (princ)
)

(princ
  "Fine Align Loaded.\nUsage: F-ALIGN. Select block and move it with W,A,S,D keys. Rotate it with <,> keys\n"
)